home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch15 / Backface.frm (.txt) < prev    next >
Visual Basic Form  |  1999-06-30  |  23KB  |  817 lines
  1. VERSION 5.00
  2. Begin VB.Form frmBackface 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Backface"
  6.    ClientHeight    =   4320
  7.    ClientLeft      =   1410
  8.    ClientTop       =   540
  9.    ClientWidth     =   6330
  10.    BeginProperty Font 
  11.       Name            =   "MS Sans Serif"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   700
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    KeyPreview      =   -1  'True
  21.    LinkTopic       =   "Form1"
  22.    PaletteMode     =   1  'UseZOrder
  23.    ScaleHeight     =   4320
  24.    ScaleWidth      =   6330
  25.    Begin VB.OptionButton optSolid 
  26.       Caption         =   "Sphere"
  27.       Height          =   255
  28.       Index           =   9
  29.       Left            =   0
  30.       TabIndex        =   11
  31.       Top             =   3960
  32.       Width           =   2055
  33.    End
  34.    Begin VB.OptionButton optSolid 
  35.       Caption         =   "8 Cubes"
  36.       Height          =   255
  37.       Index           =   7
  38.       Left            =   0
  39.       TabIndex        =   10
  40.       Top             =   3240
  41.       Width           =   2055
  42.    End
  43.    Begin VB.OptionButton optSolid 
  44.       Caption         =   "Stellate Octahedron"
  45.       Height          =   255
  46.       Index           =   8
  47.       Left            =   0
  48.       TabIndex        =   9
  49.       Top             =   3600
  50.       Width           =   2055
  51.    End
  52.    Begin VB.OptionButton optSolid 
  53.       Caption         =   "Figure 15.4b"
  54.       Height          =   255
  55.       Index           =   6
  56.       Left            =   0
  57.       TabIndex        =   8
  58.       Top             =   2880
  59.       Width           =   2055
  60.    End
  61.    Begin VB.OptionButton optSolid 
  62.       Caption         =   "Figure 15.4a"
  63.       Height          =   255
  64.       Index           =   5
  65.       Left            =   0
  66.       TabIndex        =   7
  67.       Top             =   2520
  68.       Width           =   2055
  69.    End
  70.    Begin VB.OptionButton optSolid 
  71.       Caption         =   "Icosahedron"
  72.       Height          =   255
  73.       Index           =   4
  74.       Left            =   0
  75.       TabIndex        =   6
  76.       Top             =   2160
  77.       Width           =   2055
  78.    End
  79.    Begin VB.OptionButton optSolid 
  80.       Caption         =   "Dodecahedron"
  81.       Height          =   255
  82.       Index           =   3
  83.       Left            =   0
  84.       TabIndex        =   5
  85.       Top             =   1800
  86.       Width           =   2055
  87.    End
  88.    Begin VB.OptionButton optSolid 
  89.       Caption         =   "Octahredon"
  90.       Height          =   255
  91.       Index           =   2
  92.       Left            =   0
  93.       TabIndex        =   4
  94.       Top             =   1440
  95.       Width           =   2055
  96.    End
  97.    Begin VB.OptionButton optSolid 
  98.       Caption         =   "Cube"
  99.       Height          =   255
  100.       Index           =   1
  101.       Left            =   0
  102.       TabIndex        =   3
  103.       Top             =   1080
  104.       Width           =   2055
  105.    End
  106.    Begin VB.OptionButton optSolid 
  107.       Caption         =   "Tetrahedron"
  108.       Height          =   255
  109.       Index           =   0
  110.       Left            =   0
  111.       TabIndex        =   2
  112.       Top             =   720
  113.       Width           =   2055
  114.    End
  115.    Begin VB.CheckBox chkRemoveBackfaces 
  116.       Caption         =   "Remove Backfaces"
  117.       Height          =   495
  118.       Left            =   0
  119.       TabIndex        =   1
  120.       Top             =   0
  121.       Width           =   2055
  122.    End
  123.    Begin VB.PictureBox picCanvas 
  124.       AutoRedraw      =   -1  'True
  125.       Height          =   4215
  126.       Left            =   2160
  127.       ScaleHeight     =   277
  128.       ScaleMode       =   3  'Pixel
  129.       ScaleWidth      =   261
  130.       TabIndex        =   0
  131.       Top             =   0
  132.       Width           =   3975
  133.    End
  134. Attribute VB_Name = "frmBackface"
  135. Attribute VB_GlobalNameSpace = False
  136. Attribute VB_Creatable = False
  137. Attribute VB_PredeclaredId = True
  138. Attribute VB_Exposed = False
  139. Option Explicit
  140. ' Location of viewing eye.
  141. Private EyeR As Single
  142. Private EyeTheta As Single
  143. Private EyePhi As Single
  144. Private Const dtheta = PI / 20
  145. Private Const dphi = PI / 20
  146. Private Const Dr = 1
  147. ' Location of focus point.
  148. Private Const FocusX = 0#
  149. Private Const FocusY = 0#
  150. Private Const FocusZ = 0#
  151. Private Projector(1 To 4, 1 To 4) As Single
  152. Private TheSolid As Solid3d
  153. Private SelectedShape As Integer
  154. ' Make a sphere.
  155. Private Sub MakeSphere(ByVal Cx As Single, ByVal Cy As Single, ByVal Cz As Single, ByVal radius As Single, ByVal num_horizontal As Integer, ByVal num_vertical As Integer)
  156. Dim T As Integer
  157. Dim theta1 As Single
  158. Dim theta2 As Single
  159. Dim dtheta As Single
  160. Dim P As Integer
  161. Dim phi1 As Single
  162. Dim phi2 As Single
  163. Dim dphi As Single
  164. Dim x11 As Single   ' xij: theta = i, phi = j
  165. Dim y11 As Single
  166. Dim z11 As Single
  167. Dim x12 As Single
  168. Dim y12 As Single
  169. Dim z12 As Single
  170. Dim x21 As Single
  171. Dim y21 As Single
  172. Dim z21 As Single
  173. Dim x22 As Single
  174. Dim y22 As Single
  175. Dim z22 As Single
  176. Dim R As Single
  177.     theta1 = 0
  178.     dtheta = 2 * PI / num_horizontal
  179.     For T = 1 To num_horizontal
  180.         theta2 = theta1 + dtheta
  181.         phi1 = -PI / 2
  182.         dphi = PI / num_vertical
  183.         x11 = 0
  184.         y11 = -radius
  185.         z11 = 0
  186.         x21 = 0
  187.         y21 = -radius
  188.         z21 = 0
  189.         For P = 1 To num_vertical
  190.             phi2 = phi1 + dphi
  191.             y12 = radius * Sin(phi2)
  192.             R = radius * Cos(phi2)
  193.             x12 = R * Cos(theta1)
  194.             z12 = R * Sin(theta1)
  195.             y22 = radius * Sin(phi2)
  196.             R = radius * Cos(phi2)
  197.             x22 = R * Cos(theta2)
  198.             z22 = R * Sin(theta2)
  199.             If P = 1 Then
  200.                 ' Bottom triangle.
  201.                 TheSolid.AddFace _
  202.                     Cx + x11, Cy + y11, Cz + z11, _
  203.                     Cx + x12, Cy + y12, Cz + z12, _
  204.                     Cx + x22, Cy + y22, Cz + z22
  205.             ElseIf P = num_vertical Then
  206.                 ' Top triangle.
  207.                 TheSolid.AddFace _
  208.                     Cx + x11, Cy + y11, Cz + z11, _
  209.                     Cx + x12, Cy + y12, Cz + z12, _
  210.                     Cx + x21, Cy + y21, Cz + z21
  211.             Else
  212.                 ' Middle rectangle.
  213.                 TheSolid.AddFace _
  214.                     Cx + x11, Cy + y11, Cz + z11, _
  215.                     Cx + x12, Cy + y12, Cz + z12, _
  216.                     Cx + x22, Cy + y22, Cz + z22, _
  217.                     Cx + x21, Cy + y21, Cz + z21
  218.             End If
  219.             x11 = x12
  220.             y11 = y12
  221.             z11 = z12
  222.             x21 = x22
  223.             y21 = y22
  224.             z21 = z22
  225.             phi1 = phi2
  226.         Next P
  227.         theta1 = theta2
  228.     Next T
  229. End Sub
  230. ' Draw the data.
  231. Private Sub DrawData(ByVal pic As PictureBox)
  232. Dim X As Single
  233. Dim Y As Single
  234. Dim Z As Single
  235. Dim S(1 To 4, 1 To 4) As Single
  236. Dim T(1 To 4, 1 To 4) As Single
  237. Dim ST(1 To 4, 1 To 4) As Single
  238. Dim PST(1 To 4, 1 To 4) As Single
  239.     ' Prevent overflow errors when drawing lines
  240.     ' too far out of bounds.
  241.     On Error Resume Next
  242.     ' Cull backfaces.
  243.     TheSolid.Culled = False
  244.     If chkRemoveBackfaces.value = vbChecked Then
  245.         m3SphericalToCartesian EyeR, EyeTheta, EyePhi, X, Y, Z
  246.         TheSolid.Cull X, Y, Z
  247.     End If
  248.     ' Scale and translate so it looks OK in pixels.
  249.     m3Scale S, 100, -100, 1
  250.     m3Translate T, picCanvas.ScaleWidth / 2, picCanvas.ScaleHeight / 2, 0
  251.     m3MatMultiplyFull ST, S, T
  252.     m3MatMultiplyFull PST, Projector, ST
  253.     ' Transform the points.
  254.     TheSolid.ApplyFull PST
  255.     ' Clip faces behind the center of projection.
  256.     TheSolid.ClipEye EyeR
  257.     ' Display the data.
  258.     pic.Cls
  259.     TheSolid.Draw pic, EyeR
  260.     pic.Refresh
  261. End Sub
  262. ' Make a solid like the one shown in Figure 15.4b.
  263. Private Sub MakeFig15_4b()
  264. Const S = 0.75
  265.     TheSolid.AddFace _
  266.         S, S, S, _
  267.         -S, S, S, _
  268.         -S, -S, S, _
  269.         S, -S, S
  270.     TheSolid.AddFace _
  271.         S, S, S, _
  272.         S, -S, S, _
  273.         S, -S, -S, _
  274.         S, S, -S
  275.     TheSolid.AddFace _
  276.         S, S, -S, _
  277.         S, -S, -S, _
  278.         -S, -S, -S, _
  279.         -S, S, -S
  280.     TheSolid.AddFace _
  281.         S, S, -S, _
  282.         -S, S, -S, _
  283.         0, S, 0, _
  284.         -S, S, S, _
  285.         S, S, S
  286.     TheSolid.AddFace _
  287.         S, -S, S, _
  288.         -S, -S, S, _
  289.         0, -S, 0, _
  290.         -S, -S, -S, _
  291.         S, -S, -S
  292.     TheSolid.AddFace _
  293.         -S, S, -S, _
  294.         -S, -S, -S, _
  295.         0, -S, 0, _
  296.         0, S, 0
  297.     TheSolid.AddFace _
  298.         0, S, 0, _
  299.         0, -S, 0, _
  300.         -S, -S, S, _
  301.         -S, S, S
  302. End Sub
  303. ' Make a solid like the one shown in Figure 15.4a.
  304. Private Sub MakeFig15_4a()
  305. Const S = 0.75
  306.     TheSolid.AddFace _
  307.         S, S, 0, _
  308.         S, S, -S, _
  309.         -S, S, -S, _
  310.         -S, S, S, _
  311.         0, S, S
  312.     TheSolid.AddFace _
  313.         S, S, 0, _
  314.         0, S, S, _
  315.         S, 0, S
  316.     TheSolid.AddFace _
  317.         S, S, -S, _
  318.         S, S, 0, _
  319.         S, 0, S, _
  320.         S, -S, S, _
  321.         S, -S, -S
  322.     TheSolid.AddFace _
  323.         S, S, -S, _
  324.         S, -S, -S, _
  325.         -S, -S, -S, _
  326.         -S, S, -S
  327.     TheSolid.AddFace _
  328.         -S, S, -S, _
  329.         -S, -S, -S, _
  330.         -S, -S, 0, _
  331.         -S, 0, S, _
  332.         -S, S, S
  333.     TheSolid.AddFace _
  334.         -S, S, S, _
  335.         -S, 0, S, _
  336.         0, -S, S, _
  337.         S, -S, S, _
  338.         S, 0, S, _
  339.         0, S, S
  340.     TheSolid.AddFace _
  341.         -S, 0, S, _
  342.         -S, -S, 0, _
  343.         0, -S, S
  344.     TheSolid.AddFace _
  345.         S, -S, S, _
  346.         0, -S, S, _
  347.         -S, -S, 0, _
  348.         -S, -S, -S, _
  349.         S, -S, -S
  350. End Sub
  351. ' Redraw the picture with culling changed.
  352. Private Sub chkRemoveBackfaces_Click()
  353.     DrawData picCanvas
  354.     picCanvas.SetFocus
  355. End Sub
  356. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  357.     Select Case KeyCode
  358.         Case vbKeyLeft
  359.             EyeTheta = EyeTheta - dtheta
  360.         
  361.         Case vbKeyRight
  362.             EyeTheta = EyeTheta + dtheta
  363.         
  364.         Case vbKeyUp
  365.             EyePhi = EyePhi - dphi
  366.         
  367.         Case vbKeyDown
  368.             EyePhi = EyePhi + dphi
  369.                 
  370.         Case Else
  371.             Exit Sub
  372.     End Select
  373.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  374.     DrawData picCanvas
  375. End Sub
  376. Private Sub Form_KeyPress(KeyAscii As Integer)
  377.     Select Case KeyAscii
  378.         Case Asc("+")
  379.             EyeR = EyeR + Dr
  380.         
  381.         Case Asc("-")
  382.             EyeR = EyeR - Dr
  383.         
  384.         Case Else
  385.             Exit Sub
  386.     End Select
  387.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  388.     DrawData picCanvas
  389. End Sub
  390. Private Sub Form_Load()
  391.     ' Initialize the eye position.
  392.     EyeR = 10
  393.     EyeTheta = PI * 0.2
  394.     EyePhi = PI * 0.05
  395.     ' Initialize the projection transformation.
  396.     m3PProject Projector, m3Perspective, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  397.     ' Start with the tetrahedron.
  398.     Show
  399.     optSolid(5).value = True
  400. End Sub
  401. ' Create the data.
  402. Private Sub CreateData()
  403.     ' Create the new solid.
  404.     Set TheSolid = New Solid3d
  405.     ' Create the solid.
  406.     Select Case SelectedShape
  407.         Case 0  ' Tetrahedron.
  408.             MakeTetrahedron 0.75
  409.         Case 1  ' Cube.
  410.             MakeCube 0, 0, 0, 1
  411.         Case 2  ' Octahedron.
  412.             MakeOctahedron 1
  413.         Case 3  ' Dodecahedron.
  414.             MakeDodecahedron 1
  415.         Case 4  ' Icosahedron.
  416.             MakeIcosahedron 1
  417.         Case 5  ' Figure 15.4a.
  418.             MakeFig15_4a
  419.         Case 6  ' Figure 15.4b.
  420.             MakeFig15_4b
  421.         Case 7  ' 8 Cubes.
  422.             MakeCube 0.5, 0.5, 0.5, 0.4
  423.             MakeCube 0.5, 0.5, -0.5, 0.4
  424.             MakeCube 0.5, -0.5, 0.5, 0.4
  425.             MakeCube -0.5, 0.5, 0.5, 0.4
  426.             MakeCube 0.5, -0.5, -0.5, 0.4
  427.             MakeCube -0.5, 0.5, -0.5, 0.4
  428.             MakeCube -0.5, -0.5, 0.5, 0.4
  429.             MakeCube -0.5, -0.5, -0.5, 0.4
  430.         Case 8  ' Stellate octahedron.
  431.             MakeStellate8 0.75
  432.         Case 9  ' Sphere.
  433.             MakeSphere 0, 0, 0, 1, 10, 10
  434.     End Select
  435. End Sub
  436. ' Make a stellate octahedron.
  437. Private Sub MakeStellate8(ByVal side_scale As Single)
  438.     TheSolid.Stellate side_scale, _
  439.         0, side_scale, 0, _
  440.         0, 0, side_scale, _
  441.         side_scale, 0, 0
  442.     TheSolid.Stellate side_scale, _
  443.         0, side_scale, 0, _
  444.         side_scale, 0, 0, _
  445.         0, 0, -side_scale
  446.     TheSolid.Stellate side_scale, _
  447.         0, side_scale, 0, _
  448.         0, 0, -side_scale, _
  449.         -side_scale, 0, 0
  450.     TheSolid.Stellate side_scale, _
  451.         0, side_scale, 0, _
  452.         -side_scale, 0, 0, _
  453.         0, 0, side_scale
  454.     TheSolid.Stellate side_scale, _
  455.         0, -side_scale, 0, _
  456.         side_scale, 0, 0, _
  457.         0, 0, side_scale
  458.     TheSolid.Stellate side_scale, _
  459.         0, -side_scale, 0, _
  460.         0, 0, -side_scale, _
  461.         side_scale, 0, 0
  462.     TheSolid.Stellate side_scale, _
  463.         0, -side_scale, 0, _
  464.         -side_scale, 0, 0, _
  465.         0, 0, -side_scale
  466.     TheSolid.Stellate side_scale, _
  467.         0, -side_scale, 0, _
  468.         0, 0, side_scale, _
  469.         -side_scale, 0, 0
  470. End Sub
  471. ' Make a dodecahedron.
  472. Private Sub MakeDodecahedron(ByVal side_scale As Single)
  473. Dim theta1 As Single
  474. Dim theta2 As Single
  475. Dim s1 As Single
  476. Dim s2 As Single
  477. Dim c1 As Single
  478. Dim c2 As Single
  479. Dim M As Single
  480. Dim N As Single
  481. Dim S As Single
  482. Dim R As Single
  483. Dim A As Single
  484. Dim B As Single
  485. Dim C As Single
  486. Dim D As Single
  487. Dim H As Single
  488. Dim X As Single
  489. Dim Y As Single
  490. Dim y2 As Single
  491.     theta1 = PI * 0.4
  492.     theta2 = PI * 0.8
  493.     s1 = Sin(theta1)
  494.     c1 = Cos(theta1)
  495.     s2 = Sin(theta2)
  496.     c2 = Cos(theta2)
  497.     M = 1 - (2 - 2 * c1 - 4 * s1 * s1) / (2 * c1 - 2)
  498.     N = Sqr((2 - 2 * c1) - M * M) * (1 + (1 - c2) / (c1 - c2))
  499.     R = 2 / N * side_scale
  500.     S = R * Sqr(2 - 2 * c1)
  501.     A = R * s1
  502.     B = R * s2
  503.     C = R * c1
  504.     D = R * c2
  505.     H = R * (c1 - s1)
  506.     X = (R * R * (2 - 2 * c1) - 4 * A * A) / (2 * C - 2 * R)
  507.     Y = Sqr(S * S - (R - X) * (R - X))
  508.     y2 = Y * (1 - c2) / (c1 - c2)
  509.     TheSolid.AddFace _
  510.         C, side_scale, -A, _
  511.         D, side_scale, -B, _
  512.         D, side_scale, B, _
  513.         C, side_scale, A, _
  514.         R, side_scale, 0
  515.     TheSolid.AddFace _
  516.         C, side_scale, A, _
  517.         X * c1, side_scale - Y, X * s1, _
  518.         -X * c2, side_scale - y2, X * s2, _
  519.         X, side_scale - Y, 0, _
  520.         R, side_scale, 0
  521.     TheSolid.AddFace _
  522.         C, side_scale, A, _
  523.         D, side_scale, B, _
  524.         X * c2, side_scale - Y, X * s2, _
  525.         -X * c1, side_scale - y2, X * s1, _
  526.         X * c1, side_scale - Y, X * s1
  527.     TheSolid.AddFace _
  528.         D, side_scale, B, _
  529.         D, side_scale, -B, _
  530.         X * c2, side_scale - Y, -X * s2, _
  531.         -X, side_scale - y2, 0, _
  532.         X * c2, side_scale - Y, X * s2
  533.     TheSolid.AddFace _
  534.         D, side_scale, -B, _
  535.         C, side_scale, -A, _
  536.         X * c1, side_scale - Y, -X * s1, _
  537.         -X * c1, side_scale - y2, -X * s1, _
  538.         X * c2, side_scale - Y, -X * s2, -X * c1
  539.     TheSolid.AddFace _
  540.         C, side_scale, -A, _
  541.         R, side_scale, 0, _
  542.         X, side_scale - Y, 0, _
  543.         -X * c2, side_scale - y2, -X * s2, _
  544.         X * c1, side_scale - Y, -X * s1
  545.     ' Bottom.
  546.     TheSolid.AddFace _
  547.         -D, -side_scale, -B, _
  548.         -X * c2, side_scale - y2, -X * s2, _
  549.         X, side_scale - Y, 0, _
  550.         -X * c2, side_scale - y2, X * s2, _
  551.         -D, -side_scale, B
  552.     TheSolid.AddFace _
  553.         -D, -side_scale, B, _
  554.         -X * c2, side_scale - y2, X * s2, _
  555.         X * c1, side_scale - Y, X * s1, _
  556.         -X * c1, side_scale - y2, X * s1, _
  557.         -C, -side_scale, A
  558.     TheSolid.AddFace _
  559.         -C, -side_scale, A, _
  560.         -X * c1, side_scale - y2, X * s1, _
  561.         X * c2, side_scale - Y, X * s2, _
  562.         -X, side_scale - y2, 0, _
  563.         -R, -side_scale, 0
  564.     TheSolid.AddFace _
  565.         -R, -side_scale, 0, _
  566.         -X, side_scale - y2, 0, _
  567.         X * c2, side_scale - Y, -X * s2, _
  568.         -X * c1, side_scale - y2, -X * s1, _
  569.         -C, -side_scale, -A
  570.     TheSolid.AddFace _
  571.         -C, -side_scale, -A, _
  572.         -X * c1, side_scale - y2, -X * s1, _
  573.         X * c1, side_scale - Y, -X * s1, _
  574.         -X * c2, side_scale - y2, -X * s2, _
  575.         -D, -side_scale, -B
  576.     TheSolid.AddFace _
  577.         -D, -side_scale, -B, _
  578.         -D, -side_scale, B, _
  579.         -C, -side_scale, A, _
  580.         -R, -side_scale, 0, _
  581.         -C, -side_scale, -A
  582. End Sub
  583. ' Make an icosahedron.
  584. Private Sub MakeIcosahedron(ByVal side_scale As Single)
  585. Dim theta1 As Single
  586. Dim theta2 As Single
  587. Dim s1 As Single
  588. Dim s2 As Single
  589. Dim c1 As Single
  590. Dim c2 As Single
  591. Dim A As Single
  592. Dim B As Single
  593. Dim C As Single
  594. Dim D As Single
  595. Dim H As Single
  596. Dim S As Single
  597. Dim R As Single
  598.     theta1 = PI * 0.4
  599.     theta2 = PI * 0.8
  600.     s1 = Sin(theta1)
  601.     c1 = Cos(theta1)
  602.     s2 = Sin(theta2)
  603.     c2 = Cos(theta2)
  604.     R = 2 / (2 * Sqr(1 - 2 * c1) + Sqr(3 / 4 * (2 - 2 * c1) - 2 * c2 - c2 * c2 - 1)) * side_scale
  605.     S = R * Sqr(2 - 2 * c1)
  606.     H = side_scale - Sqr(S * S - R * R)
  607.     A = R * s1
  608.     B = R * s2
  609.     C = R * c1
  610.     D = R * c2
  611.     ' Top.
  612.     TheSolid.AddFace _
  613.         0, side_scale, 0, _
  614.         C, H, A, _
  615.         R, H, 0
  616.     TheSolid.AddFace _
  617.         0, side_scale, 0, _
  618.         R, H, 0, _
  619.         C, H, -A
  620.     TheSolid.AddFace _
  621.         0, side_scale, 0, _
  622.         C, H, -A, _
  623.         D, H, -B
  624.     TheSolid.AddFace _
  625.         0, side_scale, 0, _
  626.         D, H, -B, _
  627.         D, H, B
  628.     TheSolid.AddFace _
  629.         0, side_scale, 0, _
  630.         D, H, B, _
  631.         C, H, A
  632.     ' Upper Middle.
  633.     TheSolid.AddFace _
  634.         R, H, 0, _
  635.         C, H, A, _
  636.         -D, -H, B
  637.     TheSolid.AddFace _
  638.         C, H, A, _
  639.         D, H, B, _
  640.         -C, -H, A
  641.     TheSolid.AddFace _
  642.         D, H, B, _
  643.         D, H, -B, _
  644.         -R, -H, 0
  645.     TheSolid.AddFace _
  646.         D, H, -B, _
  647.         C, H, -A, _
  648.         -C, -H, -A
  649.     TheSolid.AddFace _
  650.         C, H, -A, _
  651.         R, H, 0, _
  652.         -D, -H, -B
  653.     ' Lower Middle.
  654.     TheSolid.AddFace _
  655.         R, H, 0, _
  656.         -D, -H, B, _
  657.         -D, -H, -B
  658.     TheSolid.AddFace _
  659.         C, H, A, _
  660.         -C, -H, A, _
  661.         -D, -H, B
  662.     TheSolid.AddFace _
  663.         D, H, B, _
  664.         -R, -H, 0, _
  665.         -C, -H, A
  666.     TheSolid.AddFace _
  667.         D, H, -B, _
  668.         -C, -H, -A, _
  669.         -R, -H, 0
  670.     TheSolid.AddFace _
  671.         C, H, -A, _
  672.         -D, -H, -B, _
  673.         -C, -H, -A
  674.     ' Bottom.
  675.     TheSolid.AddFace _
  676.         0, -side_scale, 0, _
  677.         -D, -H, B, _
  678.         -C, -H, A
  679.     TheSolid.AddFace _
  680.         0, -side_scale, 0, _
  681.         -C, -H, A, _
  682.         -R, -H, 0
  683.     TheSolid.AddFace _
  684.         0, -side_scale, 0, _
  685.         -R, -H, 0, _
  686.         -C, -H, -A
  687.     TheSolid.AddFace _
  688.         0, -side_scale, 0, _
  689.         -C, -H, -A, _
  690.         -D, -H, -B
  691.     TheSolid.AddFace _
  692.         0, -side_scale, 0, _
  693.         -D, -H, -B, _
  694.         -D, -H, B
  695. End Sub
  696. ' Make an octahedron.
  697. Private Sub MakeOctahedron(ByVal side_scale As Single)
  698.     ' Top.
  699.     TheSolid.AddFace _
  700.         0, side_scale, 0, _
  701.         side_scale, 0, 0, _
  702.         0, 0, -side_scale
  703.     TheSolid.AddFace _
  704.         0, side_scale, 0, _
  705.         0, 0, -side_scale, _
  706.         -side_scale, 0, 0
  707.     TheSolid.AddFace _
  708.         0, side_scale, 0, _
  709.         -side_scale, 0, 0, _
  710.         0, 0, side_scale
  711.     TheSolid.AddFace _
  712.         0, side_scale, 0, _
  713.         0, 0, side_scale, _
  714.         side_scale, 0, 0
  715.     ' Bottom.
  716.     TheSolid.AddFace _
  717.         0, -side_scale, 0, _
  718.         side_scale, 0, 0, _
  719.         0, 0, side_scale
  720.     TheSolid.AddFace _
  721.         0, -side_scale, 0, _
  722.         0, 0, side_scale, _
  723.         -side_scale, 0, 0
  724.     TheSolid.AddFace _
  725.         0, -side_scale, 0, _
  726.         -side_scale, 0, 0, _
  727.         0, 0, -side_scale
  728.     TheSolid.AddFace _
  729.         0, -side_scale, 0, _
  730.         0, 0, -side_scale, _
  731.         side_scale, 0, 0
  732. End Sub
  733. ' Make a cube with the indicated center and
  734. ' side length.
  735. Private Sub MakeCube(ByVal Cx As Single, ByVal Cy As Single, ByVal Cz As Single, ByVal side_length As Single)
  736. Dim s2 As Single
  737.     s2 = side_length / 2
  738.     ' Top.
  739.     TheSolid.AddFace _
  740.         Cx + s2, Cy + s2, Cz + s2, _
  741.         Cx + s2, Cy + s2, Cz - s2, _
  742.         Cx - s2, Cy + s2, Cz - s2, _
  743.         Cx - s2, Cy + s2, Cz + s2
  744.     ' Positive X side.
  745.     TheSolid.AddFace _
  746.         Cx + s2, Cy + s2, Cz + s2, _
  747.         Cx + s2, Cy - s2, Cz + s2, _
  748.         Cx + s2, Cy - s2, Cz - s2, _
  749.         Cx + s2, Cy + s2, Cz - s2
  750.     ' Positive Z side.
  751.     TheSolid.AddFace _
  752.         Cx + s2, Cy + s2, Cz + s2, _
  753.         Cx - s2, Cy + s2, Cz + s2, _
  754.         Cx - s2, Cy - s2, Cz + s2, _
  755.         Cx + s2, Cy - s2, Cz + s2
  756.     ' Negative X side.
  757.     TheSolid.AddFace _
  758.         Cx - s2, Cy - s2, Cz - s2, _
  759.         Cx - s2, Cy - s2, Cz + s2, _
  760.         Cx - s2, Cy + s2, Cz + s2, _
  761.         Cx - s2, Cy + s2, Cz - s2
  762.     ' Negative Z side.
  763.     TheSolid.AddFace _
  764.         Cx - s2, Cy - s2, Cz - s2, _
  765.         Cx - s2, Cy + s2, Cz - s2, _
  766.         Cx + s2, Cy + s2, Cz - s2, _
  767.         Cx + s2, Cy - s2, Cz - s2
  768.     ' Bottom.
  769.     TheSolid.AddFace _
  770.         Cx - s2, Cy - s2, Cz - s2, _
  771.         Cx + s2, Cy - s2, Cz - s2, _
  772.         Cx + s2, Cy - s2, Cz + s2, _
  773.         Cx - s2, Cy - s2, Cz + s2
  774. End Sub
  775. ' Make a tetrahedron.
  776. Private Sub MakeTetrahedron(ByVal side_length As Single)
  777. Dim S As Single
  778. Dim A As Single
  779. Dim B As Single
  780. Dim C As Single
  781. Dim D As Single
  782.     S = Sqr(6) * side_length
  783.     A = S / Sqr(3)
  784.     B = -A / 2
  785.     C = A * Sqr(2) - 1
  786.     D = S / 2
  787.     TheSolid.AddFace _
  788.         0, C, 0, _
  789.         A, -1, 0, _
  790.         B, -1, -D
  791.     TheSolid.AddFace _
  792.         0, C, 0, _
  793.         B, -1, -D, _
  794.         B, -1, D
  795.     TheSolid.AddFace _
  796.         0, C, 0, _
  797.         B, -1, D, _
  798.         A, -1, 0
  799.     TheSolid.AddFace _
  800.         A, -1, 0, _
  801.         B, -1, D, _
  802.         B, -1, -D
  803. End Sub
  804. ' Make the drawing areas as large as possible.
  805. Private Sub Form_Resize()
  806. Dim wid As Single
  807.     wid = ScaleWidth - picCanvas.Left
  808.     If wid < 120 Then wid = 120
  809.     picCanvas.Move picCanvas.Left, 0, wid, ScaleHeight
  810. End Sub
  811. Private Sub optSolid_Click(Index As Integer)
  812.     SelectedShape = Index
  813.     CreateData
  814.     DrawData picCanvas
  815.     picCanvas.SetFocus
  816. End Sub
  817.